Introduction

This rmd. file imports oxygen and voltage data from Google sheet Data is used to plot a oxygen and voltage gradient map of the winogradsky column Exponential and linear models were used to analyze data

#Loading Packages

library(tidyverse) 
library(googledrive) 
library(googlesheets4)
#library(ggplot2)
library(knitr)
library(minpack.lm)
Warning: package ‘minpack.lm’ was built under R version 4.4.2
library(broom)
library(purrr)
library(lme4)
Warning: package ‘lme4’ was built under R version 4.4.2Loading required package: Matrix

Attaching package: ‘Matrix’

The following objects are masked from ‘package:tidyr’:

    expand, pack, unpack

#Importing from google sheet


googlesheets4::gs4_deauth()

CleanData_Oxygen <- googlesheets4::read_sheet("https://docs.google.com/spreadsheets/d/1hNakCyqPsTNRFpf1lGjoBQ-papyZ6xHKT6mcvh3LMb8/edit?pli=1&gid=842906991#gid=842906991", "CleanData_Oxygen") |>
  mutate(Sample = as.character(Sample))
✔ Reading from Microcosms.
✔ Range ''CleanData_Oxygen''.
kable(CleanData_Oxygen) 
Sample Depth_cm DO_µg_L temp_C
1004 0.0 276.0 21.2
1004 6.2 276.0 21.2
1004 8.4 275.0 21.2
1004 13.1 6.3 21.2
1004 22.0 3.4 21.2
1003 0.0 101.0 20.0
1003 5.8 62.0 20.0
1003 8.4 52.0 20.0
1003 13.1 29.0 20.0
1003 21.3 21.0 20.0
1002 0.0 80.0 19.8
1002 6.6 45.0 19.8
1002 9.3 26.0 19.8
1002 15.1 21.0 19.8
1002 21.9 19.0 19.8
1001_C 0.0 190.0 19.0
1001_C 6.9 106.0 19.0
1001_C 10.8 99.0 19.0
1001_C 16.6 57.0 19.0
1001_C 22.7 25.0 19.0
1001_W 0.0 103.0 19.0
1001_W 6.7 34.0 19.0
1001_W 10.2 21.0 19.0
1001_W 15.2 11.0 19.0
1001_W 22.8 8.0 19.0

googlesheets4::gs4_deauth()

CleanData_Voltage <- googlesheets4::read_sheet("https://docs.google.com/spreadsheets/d/1hNakCyqPsTNRFpf1lGjoBQ-papyZ6xHKT6mcvh3LMb8/edit?pli=1&gid=842906991#gid=842906991", "CleanData_Voltage") |>
  mutate(Sample = as.character(Sample))
✔ Reading from Microcosms.
✔ Range ''CleanData_Voltage''.
kable(CleanData_Voltage)
Sample Depth_cm Voltage_Water_10s Voltage_Water_Max Voltage_Tap_10s Voltage_Tap_Max
1004 0.0 NA NA 121.0 121.0
1004 6.2 160.2 190 -168.0 -168.0
1004 8.4 74.4 79 84.0 122.0
1004 13.1 -55.0 58 43.0 51.0
1004 22.0 -200.0 204 84.0 102.0
1003 0.0 NA NA 74.0 300.0
1003 5.8 27.0 27 -13.0 26.0
1003 8.4 59.0 83 57.0 57.0
1003 13.1 -20.0 101 -94.0 -136.0
1003 21.3 -25.0 -30 161.0 177.0
1002 0.0 NA NA 51.0 199.0
1002 6.6 -39.0 -40 13.0 30.0
1002 9.3 -4.3 30 196.0 199.0
1002 15.1 24.0 -4 16.0 25.0
1002 21.9 27.0 28 194.0 199.0
1001_C 0.0 NA NA 187.0 187.0
1001_C 6.9 -10.0 -22 76.0 300.0
1001_C 10.8 25.0 60 -2.8 -2.8
1001_C 16.6 -6.0 -23 -10.5 -3.0
1001_C 22.7 6.0 48 168.0 174.0
1001_W 0.0 NA NA 187.0 187.0
1001_W 6.7 16.0 -9 13.0 170.0
1001_W 10.2 31.0 33 -48.0 -48.0
1001_W 15.2 34.0 40 24.0 24.0
1001_W 22.8 40.0 -17 72.0 72.0

Combine O2 & Voltage data by sample & depth

Gradients <- left_join(x = CleanData_Oxygen, y = CleanData_Voltage, by = c("Sample", "Depth_cm"))

#Oxygen Gradient Plot

ggplot(data = CleanData_Oxygen) +
geom_point(aes(y = DO_µg_L, x = Depth_cm)) + 
  #scale_y_reverse() +
  #labs( title= "Oxygen Gradients", caption= "Figure X. Dissolved Oxygen (DO) (µg/L) measured in four Winogradsky colums at 5 depths (cm)") 
  #+ theme(plot.caption= element_text(size = 11, hjust=0)) +
  #geom_path(aes(y = Depth_cm, x = DO_µg_L)) +
  facet_grid(cols = vars(Sample)) +
  theme_bw()

#+ scale_y_continuous(limits = c(0, 300))
#define exponential decay function for data fitting.
exp_decay <- function(x, i, mu){y = i * exp(mu * x)}


O2_nest <- CleanData_Oxygen |>  #alternate forward pipe is %>% loaded with tidyverse
  nest(.by = "Sample") |>
  mutate(DecayFit = purrr::map(data, ~nlsLM(DO_µg_L ~ exp_decay(x = Depth_cm, i, mu),
                                            data = .x)),
         DecayTidy = purrr::map(DecayFit, tidy),
         DecayParam = purrr::map(DecayFit, glance),
         DecayPredict = purrr::map(DecayFit, augment)
         )
Warning: There were 5 warnings in `mutate()`.
The first warning was:
ℹ In argument: `DecayFit = purrr::map(...)`.
Caused by warning in `nlsLM()`:
! No starting values specified for some parameters.
Initializing ‘i’, ‘mu’ to '1.'.
Consider specifying 'start' or using a selfStart model
ℹ Run ]8;;ide:run:dplyr::last_dplyr_warnings()dplyr::last_dplyr_warnings()]8;; to see the 4 remaining warnings.
 
O2_nest |>
  unnest(cols = c(DecayPredict)) |>
  ggplot() +
  geom_point(aes(x = Depth_cm, y = DO_µg_L)) +
  geom_line(aes(x = Depth_cm, y = .fitted)) +
  geom_point(aes(x = Depth_cm, y = .resid), colour = "red") +
  facet_grid(cols = vars(unlist(Sample))) +
  theme_bw()

O2_nest |>
unnest(cols = c(DecayTidy)) |>
 select(-c(data, DecayFit, DecayParam, DecayPredict)) |>
  select(-c(statistic)) |>
  pivot_wider(id_cols = Sample, names_from = term, values_from = c(estimate, std.error, p.value)) |>
  kable()
Sample estimate_i estimate_mu std.error_i std.error_mu p.value_i p.value_mu
1004 326.62312 -0.0779518 101.553082 0.0494649 0.0487222 0.2131346
1003 100.85694 -0.0833277 3.557277 0.0059295 0.0000963 0.0007804
1002 78.61257 -0.0897172 6.441339 0.0139884 0.0011845 0.0076805
1001_C 190.11905 -0.0743515 10.391455 0.0078457 0.0003563 0.0024909
1001_W 102.49196 -0.1553412 3.251191 0.0097456 0.0000701 0.0005369

ggplot(data = Gradients) +
  geom_point(aes(x = Depth_cm, y = Voltage_Water_10s)) + 
  facet_grid(cols = vars(Sample)) + 
  theme_bw()

Gradients %>%
  ggplot() +
 geom_point(aes(x = Depth_cm, y = Voltage_Water_10s)) + 
  geom_smooth(aes( x = Depth_cm, y = Voltage_Water_10s), method = "lm", se=FALSE) +
  #facet_wrap(vars((Sample))) +
facet_grid(cols = vars(Sample)) + 
  theme_bw()

 # Fit the linear model grouped by Sample
linear_fits <- Gradients %>%
  group_by(Sample) %>%
  group_map(~ {
    model <- lm(Voltage_Water_10s ~ Depth_cm, data = .x) 
   # Get the tidy model summary
     tidy_model <- tidy(model)  
   # Add the 'Sample' variable back into the final table display
      tidy_model$Sample <- unique(.x$Sample)  
      # Return the tidy model 
    return(tidy_model)  
  }, .keep = TRUE) %>%
  bind_rows() %>%
  # Filter for 'Depth_cm' coefficient (we are examining Voltage in terms of Depth_cm)
  filter(term == "Depth_cm")  

# Selecting to include Sample, estimate of slope, std.error, and p.value in table output
linear_fits <- linear_fits %>%
  select(Sample, estimate, std.error, p.value) 
 
#Displaying the table and specifying sig digits shown
 linear_fits %>%
  kable(digits=3)
Sample estimate std.error p.value
1001_C 0.167 1.606 0.927
1001_W 1.309 0.461 0.105
1002 4.016 1.478 0.113
1003 -4.607 2.589 0.217
1004 -22.088 2.833 0.016
NA

Can only import one image at a time right now, we could choose some notable ones to display?

LS0tDQp0aXRsZTogIk94eWdlbiZWb2x0YWdlX2dyYWRpZW50cyINCm91dHB1dDogaHRtbF9ub3RlYm9vaw0KLS0tDQoNCiMgSW50cm9kdWN0aW9uDQoNClRoaXMgcm1kLiBmaWxlIGltcG9ydHMgb3h5Z2VuIGFuZCB2b2x0YWdlIGRhdGEgZnJvbSBHb29nbGUgc2hlZXQNCkRhdGEgaXMgdXNlZCB0byBwbG90IGEgb3h5Z2VuIGFuZCB2b2x0YWdlIGdyYWRpZW50IG1hcCBvZiB0aGUgd2lub2dyYWRza3kgY29sdW1uIA0KRXhwb25lbnRpYWwgYW5kIGxpbmVhciBtb2RlbHMgd2VyZSB1c2VkIHRvIGFuYWx5emUgZGF0YQ0KDQojTG9hZGluZyBQYWNrYWdlcyANCg0KYGBge3IgbG9hZGluZyBwYWNrYWdlc30NCmxpYnJhcnkodGlkeXZlcnNlKSANCmxpYnJhcnkoZ29vZ2xlZHJpdmUpIA0KbGlicmFyeShnb29nbGVzaGVldHM0KQ0KI2xpYnJhcnkoZ2dwbG90MikNCmxpYnJhcnkoa25pdHIpDQpsaWJyYXJ5KG1pbnBhY2subG0pDQpsaWJyYXJ5KGJyb29tKQ0KbGlicmFyeShwdXJycikNCmxpYnJhcnkobG1lNCkNCmBgYA0KDQojSW1wb3J0aW5nIGZyb20gZ29vZ2xlIHNoZWV0DQoNCmBgYHtyIGxvYWQgQ2xlYW5PeHlnZW5EYXRhIGRpcmVjdCBmcm9tIGdvb2dsZXNoZWV0fQ0KDQpnb29nbGVzaGVldHM0OjpnczRfZGVhdXRoKCkNCg0KQ2xlYW5EYXRhX094eWdlbiA8LSBnb29nbGVzaGVldHM0OjpyZWFkX3NoZWV0KCJodHRwczovL2RvY3MuZ29vZ2xlLmNvbS9zcHJlYWRzaGVldHMvZC8xaE5ha0N5cVBzVE5SRnBmMWxHam9CUS1wYXB5WjZ4SEtUNm1jdmgzTE1iOC9lZGl0P3BsaT0xJmdpZD04NDI5MDY5OTEjZ2lkPTg0MjkwNjk5MSIsICJDbGVhbkRhdGFfT3h5Z2VuIikgfD4NCiAgbXV0YXRlKFNhbXBsZSA9IGFzLmNoYXJhY3RlcihTYW1wbGUpKQ0KDQprYWJsZShDbGVhbkRhdGFfT3h5Z2VuKSANCmBgYA0KDQpgYGB7ciBsb2FkIENsZWFuVm9sdGFnZURhdGEgZGlyZWN0IGZyb20gZ29vZ2xlc2hlZXR9DQoNCmdvb2dsZXNoZWV0czQ6OmdzNF9kZWF1dGgoKQ0KDQpDbGVhbkRhdGFfVm9sdGFnZSA8LSBnb29nbGVzaGVldHM0OjpyZWFkX3NoZWV0KCJodHRwczovL2RvY3MuZ29vZ2xlLmNvbS9zcHJlYWRzaGVldHMvZC8xaE5ha0N5cVBzVE5SRnBmMWxHam9CUS1wYXB5WjZ4SEtUNm1jdmgzTE1iOC9lZGl0P3BsaT0xJmdpZD04NDI5MDY5OTEjZ2lkPTg0MjkwNjk5MSIsICJDbGVhbkRhdGFfVm9sdGFnZSIpIHw+DQogIG11dGF0ZShTYW1wbGUgPSBhcy5jaGFyYWN0ZXIoU2FtcGxlKSkNCg0Ka2FibGUoQ2xlYW5EYXRhX1ZvbHRhZ2UpDQpgYGANCg0KQ29tYmluZSBPMiAmIFZvbHRhZ2UgZGF0YSBieSBzYW1wbGUgJiBkZXB0aA0KYGBge3IgZ3JhZGllbnRzX2RmfQ0KR3JhZGllbnRzIDwtIGxlZnRfam9pbih4ID0gQ2xlYW5EYXRhX094eWdlbiwgeSA9IENsZWFuRGF0YV9Wb2x0YWdlLCBieSA9IGMoIlNhbXBsZSIsICJEZXB0aF9jbSIpKQ0KYGBgDQoNCg0KI094eWdlbiBHcmFkaWVudCBQbG90DQoNCmBgYHtyIE94eWdlbiBncmFkaWVudHN9DQpnZ3Bsb3QoZGF0YSA9IENsZWFuRGF0YV9PeHlnZW4pICsNCmdlb21fcG9pbnQoYWVzKHkgPSBET1/CtWdfTCwgeCA9IERlcHRoX2NtKSkgKyANCiAgI3NjYWxlX3lfcmV2ZXJzZSgpICsNCiAgI2xhYnMoIHRpdGxlPSAiT3h5Z2VuIEdyYWRpZW50cyIsIGNhcHRpb249ICJGaWd1cmUgWC4gRGlzc29sdmVkIE94eWdlbiAoRE8pICjCtWcvTCkgbWVhc3VyZWQgaW4gZm91ciBXaW5vZ3JhZHNreSBjb2x1bXMgYXQgNSBkZXB0aHMgKGNtKSIpIA0KICAjKyB0aGVtZShwbG90LmNhcHRpb249IGVsZW1lbnRfdGV4dChzaXplID0gMTEsIGhqdXN0PTApKSArDQogICNnZW9tX3BhdGgoYWVzKHkgPSBEZXB0aF9jbSwgeCA9IERPX8K1Z19MKSkgKw0KICBmYWNldF9ncmlkKGNvbHMgPSB2YXJzKFNhbXBsZSkpICsNCiAgdGhlbWVfYncoKQ0KIysgc2NhbGVfeV9jb250aW51b3VzKGxpbWl0cyA9IGMoMCwgMzAwKSkNCmBgYA0KDQpgYGB7ciBkZWNheSBmaXRzfQ0KI2RlZmluZSBleHBvbmVudGlhbCBkZWNheSBmdW5jdGlvbiBmb3IgZGF0YSBmaXR0aW5nLg0KZXhwX2RlY2F5IDwtIGZ1bmN0aW9uKHgsIGksIG11KXt5ID0gaSAqIGV4cChtdSAqIHgpfQ0KDQoNCk8yX25lc3QgPC0gQ2xlYW5EYXRhX094eWdlbiB8PiAgI2FsdGVybmF0ZSBmb3J3YXJkIHBpcGUgaXMgJT4lIGxvYWRlZCB3aXRoIHRpZHl2ZXJzZQ0KICBuZXN0KC5ieSA9ICJTYW1wbGUiKSB8Pg0KICBtdXRhdGUoRGVjYXlGaXQgPSBwdXJycjo6bWFwKGRhdGEsIH5ubHNMTShET1/CtWdfTCB+IGV4cF9kZWNheSh4ID0gRGVwdGhfY20sIGksIG11KSwNCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgZGF0YSA9IC54KSksDQogICAgICAgICBEZWNheVRpZHkgPSBwdXJycjo6bWFwKERlY2F5Rml0LCB0aWR5KSwNCiAgICAgICAgIERlY2F5UGFyYW0gPSBwdXJycjo6bWFwKERlY2F5Rml0LCBnbGFuY2UpLA0KICAgICAgICAgRGVjYXlQcmVkaWN0ID0gcHVycnI6Om1hcChEZWNheUZpdCwgYXVnbWVudCkNCiAgICAgICAgICkNCg0KIA0KYGBgDQoNCg0KYGBge3IgcGxvdCBPMiBkZWNheSBmaXRzfQ0KTzJfbmVzdCB8Pg0KICB1bm5lc3QoY29scyA9IGMoRGVjYXlQcmVkaWN0KSkgfD4NCiAgZ2dwbG90KCkgKw0KICBnZW9tX3BvaW50KGFlcyh4ID0gRGVwdGhfY20sIHkgPSBET1/CtWdfTCkpICsNCiAgZ2VvbV9saW5lKGFlcyh4ID0gRGVwdGhfY20sIHkgPSAuZml0dGVkKSkgKw0KICBnZW9tX3BvaW50KGFlcyh4ID0gRGVwdGhfY20sIHkgPSAucmVzaWQpLCBjb2xvdXIgPSAicmVkIikgKw0KICBmYWNldF9ncmlkKGNvbHMgPSB2YXJzKHVubGlzdChTYW1wbGUpKSkgKw0KICB0aGVtZV9idygpDQpgYGANCg0KYGBge3Igc2hvdyBmaXQgcGFyYW1ldGVyc30NCk8yX25lc3QgfD4NCnVubmVzdChjb2xzID0gYyhEZWNheVRpZHkpKSB8Pg0KIHNlbGVjdCgtYyhkYXRhLCBEZWNheUZpdCwgRGVjYXlQYXJhbSwgRGVjYXlQcmVkaWN0KSkgfD4NCiAgc2VsZWN0KC1jKHN0YXRpc3RpYykpIHw+DQogIHBpdm90X3dpZGVyKGlkX2NvbHMgPSBTYW1wbGUsIG5hbWVzX2Zyb20gPSB0ZXJtLCB2YWx1ZXNfZnJvbSA9IGMoZXN0aW1hdGUsIHN0ZC5lcnJvciwgcC52YWx1ZSkpIHw+DQogIGthYmxlKCkNCmBgYA0KYGBge3IgUGxvdHRpbmcgVm9sdGFnZSBHcmFkaWVudHMgaW4gd2F0ZXIgYXQgMTAgc2Vjb25kc30NCg0KZ2dwbG90KGRhdGEgPSBHcmFkaWVudHMpICsNCiAgZ2VvbV9wb2ludChhZXMoeCA9IERlcHRoX2NtLCB5ID0gVm9sdGFnZV9XYXRlcl8xMHMpKSArIA0KICBmYWNldF9ncmlkKGNvbHMgPSB2YXJzKFNhbXBsZSkpICsgDQogIHRoZW1lX2J3KCkNCmBgYA0KDQpgYGB7ciBQbG90dGluZyBXaXRoIGEgbGluZWFyIGZpdH0NCkdyYWRpZW50cyAlPiUNCiAgZ2dwbG90KCkgKw0KIGdlb21fcG9pbnQoYWVzKHggPSBEZXB0aF9jbSwgeSA9IFZvbHRhZ2VfV2F0ZXJfMTBzKSkgKyANCiAgZ2VvbV9zbW9vdGgoYWVzKCB4ID0gRGVwdGhfY20sIHkgPSBWb2x0YWdlX1dhdGVyXzEwcyksIG1ldGhvZCA9ICJsbSIsIHNlPUZBTFNFKSArDQogICNmYWNldF93cmFwKHZhcnMoKFNhbXBsZSkpKSArDQpmYWNldF9ncmlkKGNvbHMgPSB2YXJzKFNhbXBsZSkpICsgDQogIHRoZW1lX2J3KCkNCmBgYA0KYGBge3IgR2VuZXJhdGluZyB0aGUgbGluZWFyIG1vZGVsIGZvciB0aGUgcGxvdHN9DQogIyBGaXQgdGhlIGxpbmVhciBtb2RlbCBncm91cGVkIGJ5IFNhbXBsZQ0KbGluZWFyX2ZpdHMgPC0gR3JhZGllbnRzICU+JQ0KICBncm91cF9ieShTYW1wbGUpICU+JQ0KICBncm91cF9tYXAofiB7DQogICAgbW9kZWwgPC0gbG0oVm9sdGFnZV9XYXRlcl8xMHMgfiBEZXB0aF9jbSwgZGF0YSA9IC54KSANCiAgICMgR2V0IHRoZSB0aWR5IG1vZGVsIHN1bW1hcnkNCiAgICAgdGlkeV9tb2RlbCA8LSB0aWR5KG1vZGVsKSAgDQogICAjIEFkZCB0aGUgJ1NhbXBsZScgdmFyaWFibGUgYmFjayBpbnRvIHRoZSBmaW5hbCB0YWJsZSBkaXNwbGF5DQogICAgICB0aWR5X21vZGVsJFNhbXBsZSA8LSB1bmlxdWUoLngkU2FtcGxlKSAgDQogICAgICAjIFJldHVybiB0aGUgdGlkeSBtb2RlbCANCiAgICByZXR1cm4odGlkeV9tb2RlbCkgIA0KICB9LCAua2VlcCA9IFRSVUUpICU+JQ0KICBiaW5kX3Jvd3MoKSAlPiUNCiAgIyBGaWx0ZXIgZm9yICdEZXB0aF9jbScgY29lZmZpY2llbnQgKHdlIGFyZSBleGFtaW5pbmcgVm9sdGFnZSBpbiB0ZXJtcyBvZiBEZXB0aF9jbSkNCiAgZmlsdGVyKHRlcm0gPT0gIkRlcHRoX2NtIikgIA0KDQojIFNlbGVjdGluZyB0byBpbmNsdWRlIFNhbXBsZSwgZXN0aW1hdGUgb2Ygc2xvcGUsIHN0ZC5lcnJvciwgYW5kIHAudmFsdWUgaW4gdGFibGUgb3V0cHV0DQpsaW5lYXJfZml0cyA8LSBsaW5lYXJfZml0cyAlPiUNCiAgc2VsZWN0KFNhbXBsZSwgZXN0aW1hdGUsIHN0ZC5lcnJvciwgcC52YWx1ZSkgDQogDQojRGlzcGxheWluZyB0aGUgdGFibGUgYW5kIHNwZWNpZnlpbmcgc2lnIGRpZ2l0cyBzaG93bg0KIGxpbmVhcl9maXRzICU+JQ0KICBrYWJsZShkaWdpdHM9MykNCg0KYGBgDQojIENhbiBvbmx5IGltcG9ydCBvbmUgaW1hZ2UgYXQgYSB0aW1lIHJpZ2h0IG5vdywgd2UgY291bGQgY2hvb3NlIHNvbWUgbm90YWJsZSBvbmVzIHRvIGRpc3BsYXk/DQpgYGB7ciBlY2hvPUZBTFNFLCBvdXQud2lkdGg9IjEwMCUiLCBmaWcuY2FwPSJNeSBJbWFnZSJ9DQprbml0cjo6aW5jbHVkZV9ncmFwaGljcygiLi4vZG9jcy9TbGlkZVBob3Rvcy8xMDAxXzYuNl9DLmpwZyIpDQpgYGANCg0K